Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/gentype/gentypes.frm

Visual Basic Form | 1995-05-08 | 8.1 KB | 281 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "&Proceed"
   ClientHeight    =   2835
   ClientLeft      =   1500
   ClientTop       =   1365
   ClientWidth     =   7365
   Height          =   3240
   Left            =   1440
   LinkTopic       =   "Form1"
   ScaleHeight     =   2835
   ScaleWidth      =   7365
   Top             =   1020
   Width           =   7485
   Begin Data Data1
      Caption         =   "Data1"
      Connect         =   ""
      DatabaseName    =   ""
      Exclusive       =   0   'False
      Height          =   270
      Left            =   120
      Options         =   0
      ReadOnly        =   -1  'True
      RecordSource    =   ""
      Top             =   2460
      Visible         =   0   'False
      Width           =   1155
   End
   Begin CheckBox prtrep
      Caption         =   "Generate report <Databasename>.LST"
      Height          =   435
      Left            =   1560
      TabIndex        =   6
      Top             =   1020
      Value           =   1  'Checked
      Width           =   5415
   End
   Begin TextBox tabname
      BackColor       =   &H00C0C0C0&
      Enabled         =   0   'False
      Height          =   315
      Left            =   1920
      TabIndex        =   5
      Text            =   "Working On Table:"
      Top             =   2340
      Width           =   3555
   End
   Begin CheckBox GenTypes
      Caption         =   "Output VB 3.0 TYPE statements to GENTYPES.LST"
      Height          =   435
      Left            =   1560
      TabIndex        =   4
      Top             =   600
      Value           =   1  'Checked
      Width           =   5415
   End
   Begin CommandButton Command2
      Caption         =   "&Quit"
      Height          =   495
      Left            =   4080
      TabIndex        =   3
      Top             =   1740
      Width           =   2235
   End
   Begin CommandButton Prt
      Caption         =   "&Proceed"
      Height          =   495
      Left            =   1020
      TabIndex        =   2
      Top             =   1740
      Width           =   2235
   End
   Begin TextBox Text1
      Height          =   315
      Left            =   3180
      TabIndex        =   0
      Top             =   180
      Width           =   2415
   End
   Begin Label Label1
      AutoSize        =   -1  'True
      Caption         =   "Data Base to print:"
      Height          =   195
      Left            =   1500
      TabIndex        =   1
      Top             =   240
      Width           =   1620
   End
Option Explicit
Sub Command2_Click ()
End Sub
Sub Form_Load ()
    Form1.Top = (screen.Height - Form1.Height) / 2
    Form1.Left = (screen.Width - Form1.Width) / 2
End Sub
Sub prt_Click ()
Dim rp$
Dim db As Database
Dim tnames As snapshot
Dim td As Table
Dim fld As Fields
Dim idx As Index
Dim idxcnt As Integer
Dim aq$
Dim i
Dim j
Dim x$
Dim aa$
Dim qq
Dim dset As DynaSet
    'on error GoTo ETrap
    aq$ = text1.Text
    If Len(aq$) = 0 Then
    MsgBox "Please enter a data base name..."
    text1.SetFocus
    Exit Sub
    End If
    x$ = Dir$(aq$)
    If Len(x$) = 0 Then
    MsgBox "Database : " + x$ + " not found on disk..."
    text1.SetFocus
    Exit Sub
    End If
    prt.Enabled = False
    If prtrep.Value = 1 Then
    i = InStr(1, UCase(aq$), ".MDB")
    rp$ = Mid$(aq$, 1, i) + "LST"
    Open rp$ For Output As #22
    End If
    Set db = OpenDatabase(aq$)
    Data1.DatabaseName = db.Name
    Set tnames = db.ListTables() ' Copy Table info to td("
    If GenTypes.Value = 1 Then
    Open "gentypes.lst" For Output As #2
    Print #2, "'Structures from data base: "; aq$; "as of: "; Date$; ", "; Time$
    Print #2, ""
    End If
    If prtrep.Value = 1 Then
    Print #22, "Listing of data base: "; aq$, "Date: "; Date$, "Time: "; Time$
    Print #22,
    Print #22, "Source of data: "; db.Name
    Print #22, "Connect string: "; db.Connect
    Print #22, "Transactions supported? "; db.Transactions
    Print #22, "Sort Order: "; db.CollatingOrder
    Print #22, "Updateable? "; db.Updatable
    Print #22, "Query time-out (secs): "; db.QueryTimeout
    Print #22,
    Print #22, "Number of tables: "; Str$(db.TableDefs.Count)
    Print #22,
    End If
    Do While Not tnames.EOF
    If (tnames("Attributes") And DB_SYSTEMOBJECT) <> 0 Then
        GoTo SkipTd
    End If
    aa$ = tnames("Name")
    Data1.DatabaseName = db.Name
    Data1.RecordSource = aa$
    'On Error Resume Next
    'Data1.recordset.QueryTimeout = 1
    'qq = 1
    Data1.Refresh
    'qq = 1
    'On Error GoTo ETrap
    If prtrep.Value = 1 Then
        Print #22, String$(132, "=")
        Print #22, "Table Name:      "; Data1.Recordset.Name
        Print #22, "Updateable?:     "; Data1.Recordset.Updatable
        Print #22, "Date Created:    "; tnames("DateCreated")
        Print #22, "Last Updated:    "; tnames("LastUpdated")
        Print #22, "Table Type:      ";


        If (tnames("TableType") And DB_QUERYDEF) = DB_QUERYDEF Then
         Print #22, "QUERYDEF"
        Else
        If (tnames("TableType") And DB_TABLE) = DB_TABLE Then
            Print #22, "TABLE"
            Set td = db.OpenTable(tnames("Name"))
            idxcnt = td.Indexes.Count
            Print #22, "Index count: "; Str$(idxcnt)
            If idxcnt <> 0 Then
                For i = 0 To idxcnt - 1
                Set idx = td.Indexes(i)
                Print #22, "Index name: "; idx.Name
                Print #22, "    fields: "; idx.Fields
                Print #22, "   primary: ";
                If (idx.Primary) Then Print #22, "Yes" Else Print #22, "No"
                Print #22, "    unique: ";
                If (idx.Unique) Then Print #22, "Yes" Else Print #22, "No"
                Print #22, ""
                Next i
            End If
        Else
            Print #22, "UNKNOWN"
        End If
        End If
        Print #22,
        Print #22, "Record Count:    "; tnames("RecordCount")
        Print #22, "Attributes:      "; Hex$(tnames("Attributes"))
        Print #22, "Fields:"
        Print #22, String$(132, "_")
        Print #22, "Name";
        Print #22, Tab(30); "Type";
        Print #22, Tab(45); "Size";
        Print #22, Tab(50); "Attr";
        Print #22, Tab(55); "C.O.";
        Print #22, Tab(65); "OPos";
        Print #22, Tab(70); "Source Field";
        Print #22, Tab(90); "Source Table";
        Print #22,
        Print #22,
    End If
    If GenTypes.Value = 1 Then
        Print #2, "'"; String$(80, "_")
        Print #2, "Type td_" + tnames("Name")
    End If
    tabname.Text = "Working on table: " + tnames("Name")
    For j = 0 To Data1.Recordset.Fields.Count - 1
        aq$ = ""
        Select Case Data1.Recordset.Fields(j).Type
        Case Is = 1, 2, 3
        aq$ = "Integer"
        Case Is = 4
        aq$ = "Long"
        Case Is = 5
        aq$ = "Currency"
        Case Is = 6
        aq$ = "Single"
        Case Is = 7, 8
        aq$ = "Double"
        Case Is = 9, 10
        aq$ = "String * " + Str$(Data1.Recordset.Fields(j).Size)
        Case Is = 11, 12
        aq$ = "Long"
        Case Else
        aq$ = "UNKNOWN:" + Str$(Data1.Recordset.Fields(j).Type)
        End Select
        If GenTypes.Value = 1 Then
        Print #2, "        "; Data1.Recordset.Fields(j).Name; " AS ";
        Print #2, aq$
        End If
        If Mid$(aq$, 1, 6) = "String" Then
        aq$ = "String"
        End If
        If prtrep.Value = 1 Then
        Print #22, Data1.Recordset.Fields(j).Name;
        Print #22, Tab(30); aq$;
        Print #22, Tab(45); Data1.Recordset.Fields(j).Size;
        Print #22, Tab(50); Hex$(Data1.Recordset.Fields(j).Attributes);
        Print #22, Tab(55); Str$(Data1.Recordset.Fields(j).CollatingOrder);
        Print #22, Tab(65); Str$(Data1.Recordset.Fields(j).OrdinalPosition);
        Print #22, Tab(70); Data1.Recordset.Fields(j).SourceField;
        Print #22, Tab(90); Data1.Recordset.Fields(j).SourceTable
        End If
    Next j
    If prtrep.Value = 1 Then
        Print #22,
        Print #22,
    End If
    If GenTypes.Value = 1 Then
        Print #2, "END TYPE"
    End If
SkipTd:
    'data1.Close
    tnames.MoveNext    ' Move to next record.
    Loop
    If prtrep.Value = 1 Then
    Print #22, "*** END OF REPORT ***"
    printer.EndDoc
    End If
    Beep
    Beep
    MsgBox "Printing completed!"
    End
ETrap:
    aq$ = "An error occurred! " + Chr$(13) + Chr$(10)
    aq$ = aq$ + "Code was: " + Str$(Err) + " " + Error$(Err)
    MsgBox aq$
    End
End Sub